home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / symboot.c < prev    next >
C/C++ Source or Header  |  1992-06-18  |  10KB  |  363 lines
  1. /* ******************************************************************** */
  2. /*  symbols.c        Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /*  General symbol hacking and global oblist                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, March 1990 (During compiler rationalisation)
  10.  */
  11.  
  12. #include <stdio.h>
  13. #include "funcalls.h"
  14. #include "defs.h"
  15. #include "structs.h"
  16. #include "global.h"
  17. #include "error.h"
  18. #include <string.h>
  19. #include "table.h"
  20. #include "symboot.h"
  21. #include "allocate.h"
  22. #include "copy.h"
  23.  
  24. #define strings_equal_p(a,b) (a[0] != b[0] ? FALSE : !strcmp(a,b))
  25.  
  26. LispObject ObList;
  27.  
  28.  
  29. typedef enum { LHere, LLeft, LRight, LFirst } LookupDirection;
  30.  
  31. LispObject get_symbol(LispObject* stackbase, char *name)
  32. {
  33.   static LispObject find_name_in_oblist(LispObject ,char *,LookupDirection *);
  34.   static void add_sym_to_oblist(LispObject where,LispObject sym, LookupDirection dir);
  35.   
  36.   LookupDirection dir;
  37.   LispObject newloc,sym;
  38.  
  39.   newloc=find_name_in_oblist(ObList,name,&dir);
  40.   if (dir==LHere)
  41.     return newloc;
  42.   else
  43.     { /* NOT GC SAFE */
  44.       sym=allocate_symbol(stackbase,name);
  45.       add_sym_to_oblist(newloc,sym,dir);
  46.       return sym;
  47.     }
  48.   
  49. }
  50.  
  51. /* Provided for compatibility */
  52.  
  53. LispObject get_symbol_by_copying(LispObject *stackbase,char *name)
  54. {
  55.   return(get_symbol(stackbase,name));
  56. }
  57.  
  58. static void add_sym_to_oblist(LispObject where,LispObject sym, LookupDirection dir)
  59. {
  60.   switch(dir)
  61.     {
  62.     case LLeft:
  63.       where->SYMBOL.left=sym;
  64.       break;
  65.  
  66.     case LRight:
  67.       where->SYMBOL.right=sym;
  68.       break;
  69.       
  70.     case LFirst:
  71.       ObList=sym;
  72.     }
  73. }
  74.  
  75.  
  76. static LispObject find_name_in_oblist(LispObject tree,char *str,LookupDirection *dir)
  77. {
  78.   LookupDirection mydir=LFirst;
  79.   LispObject prev=NULL;
  80.   int newhash=hash(str);
  81.   
  82.   while(TRUE)
  83.     {
  84.       if (tree==NULL)
  85.     {
  86.       *dir=mydir;
  87.       return prev;
  88.     }
  89.  
  90.       if (newhash==tree->SYMBOL.hash)
  91.     {
  92.       if (strings_equal_p(stringof(tree->SYMBOL.pname),str))
  93.         {    
  94.           *dir=LHere;
  95.           return tree;
  96.         }
  97.       else
  98.         {
  99.           prev=tree; mydir=LLeft;
  100.           tree=tree->SYMBOL.left;
  101.         }
  102.     }
  103.       else 
  104.     {
  105.       if (tree->SYMBOL.hash<newhash)
  106.         {
  107.           prev=tree; mydir=LLeft;
  108.           tree=tree->SYMBOL.left;
  109.         }
  110.       else
  111.         {
  112.           prev=tree; mydir=LRight;
  113.           tree=tree->SYMBOL.right;
  114.         }
  115.     }
  116.     }
  117. }    
  118.  
  119. int reserved_symbol_p(LispObject sym)
  120. {
  121.   return((sym == sym_dynamic ||
  122.       sym == sym_dynamic_let ||
  123.       sym == sym_dynamic_setq ||
  124.       sym == sym_dynamic_set ||
  125. /*
  126.       sym == sym_defclass ||
  127.       sym == sym_defcondition ||
  128. */
  129.       sym == sym_defconstant ||
  130. /*
  131.       sym == sym_defgeneric ||
  132. */
  133.       sym == sym_deflocal ||
  134.       sym == sym_defmacro ||
  135. /*
  136.       sym == sym_defmethod ||
  137.       sym == sym_defstruct ||
  138. */
  139.       sym == sym_defun || 
  140.       sym == sym_defvar ||
  141.       sym == sym_if ||
  142.       sym == sym_lambda ||
  143. /*
  144.       sym == sym_letcc ||
  145.           sym == sym_with_handler ||
  146. */
  147.       sym == sym_nil || 
  148.       sym == sym_quote ||
  149.       sym == lisptrue ||
  150.       sym == sym_setq));
  151. }
  152.  
  153. /* Useful symbols to have... */
  154.  
  155. LispObject sym_nil;
  156.  
  157. LispObject sym_define;
  158. LispObject sym_function,sym_macro,sym_constant;
  159.  
  160. LispObject sym_defclass,sym_defcondition,sym_defconstant,sym_defgeneric,
  161.            sym_deflocal,sym_defmacro,sym_defmethod,sym_defstruct,sym_defun;
  162.  
  163. LispObject sym_defmodule,sym_load_module,sym_start_module,sym_enter_module;
  164.  
  165. LispObject sym_root;
  166.  
  167. LispObject sym_loaded_modules;
  168.  
  169. LispObject sym_lambda,sym_macro_lambda,sym_setq,sym_if,sym_progn;
  170. LispObject sym_import,sym_expose,sym_expose_except,sym_rename,sym_export;
  171. LispObject sym_root;
  172. LispObject sym_letcc,sym_unwind_protect;
  173.  
  174. LispObject sym_methods;
  175.  
  176. LispObject sym_defvar,sym_dynamic_setq,
  177.            sym_dynamic_set,sym_dynamic,sym_dynamic_let;
  178.  
  179. LispObject sym_with_handler;
  180.  
  181. LispObject sym_rest;
  182.  
  183. LispObject sym_cons;
  184.  
  185. /* defstruct symbols... */
  186.  
  187. LispObject sym_initarg,sym_initargs,sym_initform,sym_reader,sym_writer,
  188.            sym_accessor,sym_class,sym_mutable;
  189.  
  190. LispObject sym_constructor,sym_metaclass,sym_metaclass_initargs;
  191.  
  192. LispObject sym_position;
  193.  
  194. LispObject sym_message,sym_error_value;
  195.  
  196. LispObject sym_anonymous_class;
  197.  
  198. LispObject sym_name,sym_superclass,sym_slot_descriptions;
  199.  
  200. LispObject sym_exit;
  201.  
  202. LispObject sym_evalcm;
  203.  
  204. LispObject sym_tagbody;
  205.  
  206. void initialise_symbols(LispObject *stacktop)
  207. {
  208.   /* Garbage proofed by virtue of being on the object list */
  209.   /* Better do gensyms differently... */
  210.   add_root(&ObList);
  211.   
  212.  
  213.   sym_nil = get_symbol(stacktop,"nil");
  214.   add_root(&sym_nil);
  215.   sym_define   = get_symbol(stacktop,"define");
  216.   add_root(&sym_define);
  217.   sym_function = get_symbol(stacktop,"function");
  218.   add_root(&sym_function);
  219.   sym_macro    = get_symbol(stacktop,"macro");
  220.   add_root(&sym_macro);
  221.   sym_constant = get_symbol(stacktop,"constant");
  222.   add_root(&sym_constant);
  223.   
  224.   sym_defclass     = get_symbol(stacktop,"defclass");
  225.   add_root(&sym_defclass);
  226.   sym_defcondition = get_symbol(stacktop,"defcondition");
  227.   add_root(&sym_defcondition);
  228.   sym_defconstant  = get_symbol(stacktop,"defconstant");
  229.   add_root(&sym_defconstant);
  230.   sym_defgeneric   = get_symbol(stacktop,"defgeneric");
  231.   add_root(&sym_defgeneric);
  232.   sym_deflocal     = get_symbol(stacktop,"deflocal");
  233.   add_root(&sym_deflocal);
  234.   sym_defmacro     = get_symbol(stacktop,"defmacro");
  235.   add_root(&sym_defmacro);
  236.   sym_defmethod    = get_symbol(stacktop,"defmethod");
  237.   add_root(&sym_defmethod);
  238.   sym_defstruct    = get_symbol(stacktop,"defstruct");
  239.   add_root(&sym_defstruct);
  240.   sym_defun        = get_symbol(stacktop,"defun");
  241.   add_root(&sym_defun);
  242.   
  243.   sym_defmodule  = get_symbol(stacktop,"defmodule");
  244.   add_root(&sym_defmodule);
  245.   sym_load_module = get_symbol(stacktop,"load-module");
  246.   add_root(&sym_load_module);
  247.   sym_start_module = get_symbol(stacktop,"start-module");
  248.   add_root(&sym_start_module);
  249.   sym_enter_module = get_symbol(stacktop,"enter-module");
  250.   add_root(&sym_enter_module);
  251.   sym_loaded_modules = get_symbol(stacktop,"loaded-modules");
  252.   add_root(&sym_loaded_modules);
  253.   
  254.   sym_root = get_symbol(stacktop,"root");
  255.   add_root(&sym_root);
  256.   
  257.   sym_lambda  = get_symbol(stacktop,"lambda");
  258.   add_root(&sym_lambda);
  259.   sym_macro_lambda = get_symbol(stacktop,"macro-lambda");
  260.   add_root(&sym_macro);
  261.   sym_setq    = get_symbol(stacktop,"setq");
  262.   add_root(&sym_setq);
  263.   sym_if      = get_symbol(stacktop,"if");
  264.   add_root(&sym_if);
  265.   sym_progn   = get_symbol(stacktop,"progn");
  266.   add_root(&sym_progn);
  267.   sym_quote   = get_symbol(stacktop,"quote");
  268.   add_root(&sym_quote);
  269.   
  270.   sym_import = get_symbol(stacktop,"import");
  271.   add_root(&sym_import);
  272.   sym_expose = get_symbol(stacktop,"expose");
  273.   add_root(&sym_expose);
  274.   sym_expose_except = get_symbol(stacktop,"expose-except");
  275.   add_root(&sym_expose_except);
  276.   sym_rename = get_symbol(stacktop,"rename");
  277.   add_root(&sym_rename);
  278.   
  279.   sym_export = get_symbol(stacktop,"export");
  280.   add_root(&sym_export);
  281.   
  282.   sym_root = get_symbol(stacktop,"root");
  283.   add_root(&sym_root);
  284.   
  285.   sym_letcc          = get_symbol(stacktop,"let/cc");
  286.   add_root(&sym_letcc);
  287.   sym_unwind_protect = get_symbol(stacktop,"unwind-protect");
  288.   add_root(&sym_unwind_protect);
  289.   
  290.   sym_with_handler   = get_symbol(stacktop,"with-handler");
  291.   add_root(&sym_with_handler);
  292.   
  293.   sym_methods = get_symbol(stacktop,"methods");
  294.   add_root(&sym_methods);
  295.   
  296.   sym_defvar       = get_symbol(stacktop,"defvar");
  297.   add_root(&sym_defvar);
  298.   sym_dynamic_setq = get_symbol(stacktop,"dynamic-setq");
  299.   add_root(&sym_dynamic_setq);
  300.   sym_dynamic_set  = get_symbol(stacktop,"dynamic-set");
  301.   add_root(&sym_dynamic_set);
  302.   sym_dynamic_let  = get_symbol(stacktop,"dynamic-let");
  303.   add_root(&sym_dynamic_let);
  304.   sym_dynamic      = get_symbol(stacktop,"dynamic");
  305.   add_root(&sym_dynamic);
  306.   
  307.   sym_rest = get_symbol(stacktop,"rest");
  308.   add_root(&sym_rest);
  309.   
  310.   sym_cons = get_symbol(stacktop,"cons");
  311.   add_root(&sym_cons);
  312.   
  313.   sym_initarg  = get_symbol(stacktop,"initarg");
  314.   add_root(&sym_initarg);
  315.   sym_initargs = get_symbol(stacktop,"initargs");
  316.   add_root(&sym_initargs);
  317.   sym_initform = get_symbol(stacktop,"initform");
  318.   add_root(&sym_initform);
  319.   sym_reader   = get_symbol(stacktop,"reader");
  320.   add_root(&sym_reader);
  321.   sym_writer   = get_symbol(stacktop,"writer");
  322.   add_root(&sym_writer);
  323.   sym_accessor = get_symbol(stacktop,"accessor");
  324.   add_root(&sym_accessor);
  325.   sym_class    = get_symbol(stacktop,"class");
  326.   add_root(&sym_class);
  327.   sym_mutable  = get_symbol(stacktop,"mutable");
  328.   add_root(&sym_mutable);
  329.   
  330.   sym_constructor = get_symbol(stacktop,"constructor");
  331.   add_root(&sym_constructor);
  332.   sym_metaclass   = get_symbol(stacktop,"metaclass");
  333.   add_root(&sym_metaclass);
  334.   sym_metaclass_initargs = get_symbol(stacktop,"metaclass-initargs");
  335.   add_root(&sym_metaclass_initargs);
  336.   
  337.   sym_position = get_symbol(stacktop,"position");
  338.   add_root(&sym_position);
  339.   sym_message = get_symbol(stacktop,"message");
  340.   add_root(&sym_message);
  341.   sym_error_value = get_symbol(stacktop,"error-value");
  342.   add_root(&sym_error_value);
  343.   
  344.   sym_anonymous_class = get_symbol(stacktop,"anonymous-class");
  345.   add_root(&sym_anonymous_class);
  346.   
  347.   sym_name = get_symbol(stacktop,"name");
  348.   add_root(&sym_name);
  349.   sym_superclass = get_symbol(stacktop,"superclass");
  350.   add_root(&sym_superclass);
  351.   sym_slot_descriptions = get_symbol(stacktop,"slot-descriptions");
  352.   add_root(&sym_slot_descriptions);
  353.   
  354.   sym_exit = get_symbol(stacktop,"exit");
  355.   add_root(&sym_exit);
  356.   
  357.   sym_evalcm = get_symbol(stacktop,"eval/cm");
  358.   add_root(&sym_evalcm);
  359.   
  360.   sym_tagbody = get_symbol(stacktop,"tagbody");
  361.   add_root(&sym_tagbody);
  362. }
  363.